Attribute VB_Name = "onda3d"
' To save this file, export it in a .bas module

' PI GRECO
Private Const PI As Double = 3.14159265358979

' Use values in mm
Private Const BASE_HEIGHT As Double = 35
Private Const BASE_WIDTH As Double = 125
Private Const DENTE_MAX_HEIGHT As Double = 20
Private Const DENTE_MIN_HEIGHT As Double = 7
Private Const DENTE_WIDTH As Double = 60
Private Const DENTE_HOLE_WIDTH As Double = 3
Private Const HOLE_PRE_SPACE As Double = 9
Private Const HOLE_SPACE As Double = 3

' Set if the base will be plotted single (1) or if
' it's splitted in two elements (2) with HOLE_INTERSECTION holes
' to be glued
Private Const GLUE_MODE As Long = 1
Private Const HOLE_INTERSECTION As Long = 3

Private Const FUNCTION_POINTS_COUNT As Integer = 80
' deve essere dispari o pari a seconda dell'HOLE_INTERSECTION,
' meglio se dispari in moda avere il plot su X=0
Private Const ELEMENTS_COUNT As Double = 21
' Plot function from Y_MIN to Y_MAX
Private Const Y_MIN As Double = -2
Private Const Y_MAX As Double = 2

Private Const GLUE_HEIGHT As Double = DENTE_MAX_HEIGHT + 6

Private Const BASE_WIDTH_UP As Double = (BASE_WIDTH - DENTE_WIDTH - 2 * DENTE_HOLE_WIDTH) / 2

Sub plotAll()
    plotElements
    plotGlueElements
    ZoomAll
End Sub


Sub plotGlueElements()
    Dim bGlue As AcadBlock
    Dim rGlue As AcadBlockReference
    Dim pt(0 To 2) As Double
    
    
    
    ThisDrawing.PurgeAll
    Set bGlue = glueElement()
    If GLUE_MODE = 1 Then
        pt(0) = 0
    Else
        pt(0) = holesWidth
    End If
    pt(1) = -GLUE_HEIGHT - 5: pt(2) = 0#
    Set rGlue = ThisDrawing.ModelSpace.InsertBlock(pt, bGlue.Name, 1, 1, 1, 0)
    If GLUE_MODE = 2 Then
        pt(0) = holesWidth: pt(1) = -2 * GLUE_HEIGHT - 10: pt(2) = 0#
        Set rGlue = ThisDrawing.ModelSpace.InsertBlock(pt, bGlue.Name, 1, 1, 1, 0)
    End If

End Sub



Sub plotElements()
    Dim I As Double
    Dim pMove1(0 To 2) As Double
    Dim pMove2(0 To 2) As Double
    For I = 0 To 2
        pMove1(I) = 0#: pMove2(I) = 0#
    Next
    Dim j As Long, k As Long, mirror As Integer
    Dim bLine As AcadBlock
    Dim rLine As AcadBlockReference
    ThisDrawing.PurgeAll
    j = 0
    For I = Y_MIN To Y_MAX Step (Y_MAX - Y_MIN) / (ELEMENTS_COUNT - 1)
        Set bLine = blockElement(I, j)
        If j Mod 4 = 0 Then
            pMove2(1) = j / 4 * 2 * (BASE_HEIGHT + 10) + BASE_HEIGHT + 5
        End If
        If j Mod 4 = 0 Or j Mod 4 = 2 Then
            pMove2(0) = 0
        Else
            pMove2(0) = BASE_WIDTH
        End If
        If j Mod 4 >= 2 Then
            mirror = 1
        Else
            mirror = -1
        End If
        Set rLine = ThisDrawing.ModelSpace.InsertBlock(pMove2, bLine.Name, 1, mirror, 1, 0)
        j = j + 1
        Debug.Print j
    Next
End Sub

Function blockElement(y As Double, index As Long) As AcadBlock
    Dim I As Long
    Dim pLine() As Double
    Dim bPoints() As Double
    Dim fPoints() As Double
    Dim rPoly As AcadLWPolyline
    bPoints = basePoints

    fPoints = functionPoints(FUNCTION_POINTS_COUNT, 0, BASE_WIDTH, y)
     
    ReDim pLine(0 To UBound(bPoints) + UBound(fPoints) + 1)
    
    ' temporaneamente
    For I = 0 To UBound(pLine)
        pLine(I) = 0#
    Next
    
    ' copio bPoints aggiustando gli estremi
    For I = 0 To UBound(bPoints)
        pLine(I) = bPoints(I)
        If I = 1 Then
            pLine(I) = pLine(I) + fPoints(1)
        ElseIf I = UBound(bPoints) Then
            pLine(I) = pLine(I) + fPoints(UBound(fPoints))
        End If
    Next
    ' copio fPoints shiftando su y in base a BASE_HEIGHT
    For I = 0 To UBound(fPoints)
        pLine(UBound(bPoints) + I + 1) = fPoints(I)
        If I Mod 2 = 1 Then
            pLine(UBound(bPoints) + I + 1) = pLine(UBound(bPoints) + I + 1) + BASE_HEIGHT
        End If
    Next
    Dim bElement As AcadBlock
    Dim tPoint(0 To 2) As Double
    tPoint(0) = 0#: tPoint(1) = 0#: tPoint(2) = 0#
    Set bElement = ThisDrawing.Blocks.Add(tPoint, "element" + CStr(index))
    Set rPoly = bElement.AddLightWeightPolyline(pLine)
    
    Dim reg As Variant
    Dim entity(0 To 0) As AcadEntity
    Set entity(0) = rPoly
    reg = bElement.AddRegion(entity)
    bElement.AddExtrudedSolid reg(0), -HOLE_SPACE, 0
    
    'tPoint(0) = 0.35: tPoint(1) = 0.35
    'Set rText = bElement.AddText(CStr(index), tPoint, 0.1)
    
    Set blockElement = bElement

End Function

Function basePoints() As Double()
    Dim ret(0 To 23) As Double
    Dim retV As Variant
    
    Dim I As Long
    retV = Array( _
        BASE_WIDTH, BASE_HEIGHT, _
        BASE_WIDTH, DENTE_MIN_HEIGHT, _
        BASE_WIDTH - BASE_WIDTH_UP, DENTE_MIN_HEIGHT, _
        BASE_WIDTH - BASE_WIDTH_UP, DENTE_MAX_HEIGHT, _
        BASE_WIDTH - BASE_WIDTH_UP - DENTE_HOLE_WIDTH, DENTE_MAX_HEIGHT, _
        BASE_WIDTH - BASE_WIDTH_UP - DENTE_HOLE_WIDTH, 0, _
        BASE_WIDTH_UP + DENTE_HOLE_WIDTH, 0, _
        BASE_WIDTH_UP + DENTE_HOLE_WIDTH, DENTE_MAX_HEIGHT, _
        BASE_WIDTH_UP, DENTE_MAX_HEIGHT, _
        BASE_WIDTH_UP, DENTE_MIN_HEIGHT, _
        0, DENTE_MIN_HEIGHT, _
        0, BASE_HEIGHT _
    )
    
    For I = LBound(ret) To UBound(ret)
        ret(I) = retV(I)
    Next
    basePoints = ret
End Function

Function functionPoints(pointCount As Integer, xStart As Double, xStop As Double, y As Double) As Double()
    Dim range As Double
    Dim step As Double
    Dim x As Double
    Dim z As Double
    Dim I As Integer
    Dim points() As Double
    ReDim points(0 To pointCount * 2 + 1)
    range = xStop - xStart
    step = range / CDbl(pointCount)
    I = 0
    For x = xStart To xStop + step Step step
        If x > xStop Then Exit For
        z = theFunction(1 / range * (4 * x - 2 * (xStart + xStop)), y)
        points(2 * I) = x: points(2 * I + 1) = z
        I = I + 1
        ' il due dovrebbe essere dinamico in funzione della precisione dello step
        x = FormatNumber(x, 4)
    Next
    functionPoints = points
End Function

Function theFunction(x As Double, y As Double) As Double
    theFunction = 15 * Cos(Sqr(x ^ 2 + y ^ 2) * 8) / (1 + Sqr(x ^ 2 + y ^ 2))
    'theFunction = 0
End Function


Function glueElement() As AcadBlock

    Dim bGlue As AcadBlock
    Dim bRect As AcadBlock
    Dim pt() As Double
    Dim I As Long
    ReDim pt(0 To 2)
    For I = LBound(pt) To UBound(pt)
        pt(I) = 0#
    Next
    
    Set bGlue = ThisDrawing.Blocks.Add(pt, "glue")
    
    'rectangle
    Set bRect = ThisDrawing.Blocks.Add(pt, "base_rectangle")
    ReDim pt(0 To 9)
    For I = LBound(pt) To UBound(pt)
        pt(I) = 0#
    Next
    pt(2) = DENTE_WIDTH: pt(4) = DENTE_WIDTH: pt(5) = GLUE_HEIGHT
    pt(7) = GLUE_HEIGHT
    
    Dim rPoly As AcadLWPolyline
    Set rPoly = bRect.AddLightWeightPolyline(pt)
    Dim reg As Variant
    Dim entity(0 To 0) As AcadEntity
    Set entity(0) = rPoly
    reg = bRect.AddRegion(entity)
    bRect.AddExtrudedSolid reg(0), -HOLE_SPACE, 0
    
    ReDim pt(0 To 2)
    For I = LBound(pt) To UBound(pt)
        pt(I) = 0#
    Next
    ' add bRect rectangle to bGlue
    bGlue.InsertBlock pt, bRect.Name, 1, 1, 1, 0
    If GLUE_MODE = 1 Then
        pt(0) = holesWidth + DENTE_WIDTH
        bGlue.InsertBlock pt, bRect.Name, 1, 1, 1, 0
    End If
    
    ReDim pt(0 To 2)
    For I = LBound(pt) To UBound(pt)
        pt(I) = 0#
    Next
    pt(0) = DENTE_WIDTH
    bGlue.InsertBlock pt, holePoints().Name, 1, 1, 1, 0
    If GLUE_MODE = 1 Then
        pt(0) = 2 * DENTE_WIDTH + holesWidth
        bGlue.InsertBlock pt, holePoints().Name, 1, 1, 1, 0
    Else
        pt(0) = 0
        bGlue.InsertBlock pt, holePoints().Name, -1, 1, 1, 0
    End If
    Set glueElement = bGlue
    
    
End Function

Function holePoints() As AcadBlock
    Dim pt() As Double
    Dim I As Long
    Dim rPoly As AcadLWPolyline
    Dim idx As Long
   
    ' Quanti denti bucati?
    Dim holes_count As Long
    If GLUE_MODE = 1 Then
        holes_count = ELEMENTS_COUNT
    Else
        holes_count = (ELEMENTS_COUNT + HOLE_INTERSECTION) / 2
    End If
    ' quanti punti servono?
    Dim pt_count As Long
    pt_count = 2 + 4 * holes_count + 2
    'If GLUE_MODE = 1 Then
    '    ' in this mode, we must plot another hole_pre_space at the end
    '    pt_count = pt_count + 2
    'End If
    ' disegnamo i denti
    ReDim pt(0 To 2 * pt_count + 1)
    pt(0) = 0#: pt(1) = GLUE_HEIGHT: pt(2) = HOLE_PRE_SPACE: pt(3) = GLUE_HEIGHT
    For I = 0 To holes_count - 1
        pt(8 * I + 4) = pt(8 * I + 2)
        pt(8 * I + 5) = DENTE_MAX_HEIGHT
        pt(8 * I + 6) = pt(8 * I + 4) + DENTE_HOLE_WIDTH
        pt(8 * I + 7) = DENTE_MAX_HEIGHT
        pt(8 * I + 8) = pt(8 * I + 6)
        pt(8 * I + 9) = GLUE_HEIGHT
        pt(8 * I + 10) = pt(8 * I + 8) + HOLE_SPACE
        pt(8 * I + 11) = GLUE_HEIGHT
    Next
    idx = 2 * pt_count - 4
    If GLUE_MODE = 1 Then
    '    'plot another hole_pre_space
    '    pt(idx) = pt(idx - 2) + HOLE_PRE_SPACE
    '    idx = idx + 1
    '    pt(idx) = pt(idx - 2)
    '    idx = idx + 1
        ' last is an hole_pre_space
        pt(idx - 2) = pt(idx - 2) - HOLE_SPACE + HOLE_PRE_SPACE
    End If
    pt(idx) = pt(idx - 2)
    idx = idx + 1
    pt(idx) = 0
    idx = idx + 1
    ' return to origin
    pt(idx) = 0
    idx = idx + 1
    pt(idx) = 0
    ' close geometry
    idx = idx + 1
    pt(idx) = 0
    idx = idx + 1
    pt(idx) = GLUE_HEIGHT
    Dim bElement As AcadBlock
    Dim tPoint(0 To 2) As Double
    tPoint(0) = 0#: tPoint(1) = 0#: tPoint(2) = 0#
    Set bElement = ThisDrawing.Blocks.Add(tPoint, "tooths")
    Set rPoly = bElement.AddLightWeightPolyline(pt)
    
    Dim reg As Variant
    Dim entity(0 To 0) As AcadEntity
    Set entity(0) = rPoly

    reg = bElement.AddRegion(entity)
    bElement.AddExtrudedSolid reg(0), -HOLE_SPACE, 0
    
    Set holePoints = bElement
End Function

Function holesWidth() As Double
    If GLUE_MODE = 1 Then
        holesWidth = 2 * HOLE_PRE_SPACE + ELEMENTS_COUNT * (DENTE_HOLE_WIDTH + HOLE_SPACE) - HOLE_SPACE
    Else
        holesWidth = HOLE_PRE_SPACE + (ELEMENTS_COUNT + HOLE_INTERSECTION) / 2 * (DENTE_HOLE_WIDTH + HOLE_SPACE)
    End If
End Function

' for a 3D rappresentation of result

Sub plot3DElements()
    Dim pt(0 To 2) As Double
    Dim j As Long
    Dim I As Double
    For I = 0 To 2
        pt(I) = 0#
    Next
    Dim bLine As AcadBlock
    Dim rLine As AcadBlockReference
    ThisDrawing.PurgeAll
    j = 0
    For I = Y_MIN To Y_MAX Step (Y_MAX - Y_MIN) / (ELEMENTS_COUNT - 1)
        Set bLine = blockElement(I, j)
        pt(2) = j * (HOLE_SPACE + DENTE_HOLE_WIDTH)
        ThisDrawing.ModelSpace.InsertBlock pt, bLine.Name, 1, 1, 1, 0
        j = j + 1
    Next
    ZoomAll
End Sub

